TITL DAI FIRMWARE 1E7D2-1EA0D  V1.1
        ORG   :E7D2
*
*
*
*******
* SIN *
*******
*
* MACC = SIN (MACC)  (Angle expressed in radians).
*
* See XCOS for explanation.
*
XSIN    PUSH  PSW
        PUSH  B
        PUSH  D
        PUSH  H
        JMP   :E7E3     To common part XSIN/XCOS
*
*******
* COS *
*******
*
* MACC = COS (MACC)  (Angle expressed in radians).
*
* Method: Polynomial approximation.
*
* Cos(X) is converted: cos(X) = sin(X+PI/2).
*
* Given X, N and Y are defined for:
*      X/(2*PI) = N + Y; N is integer part.
*
* All arguments are converted to a range -PI/2 to
* +PI/2:
*      sin(N*2*PI+K) = sin(K)
*      sin(PI/2+K)   = sin(PI/2-K)
*      sin(PI*3/2+K) = sin(PI*3/2-K)
*      sin(-PI/2+K)  = sin(-PI/2-K).
*
* Polynomial approx. F(Y) for sin(2*PI*Y) is:
*      F(Y) = a1*Y + a2*Y^3 + ... + a5*Y^9.
*
XCOS    PUSH  PSW
        PUSH  B
        PUSH  D
        PUSH  H
        LXI   H,:E833   Addr PI/2
        CALL  :EA72     X = X + PI/2
 REM
* Entry from XSIN:
 REM
L1E132  LXI   H,:E83F   Addr PI*2
        CALL  :EA20     MACC = X/(2*PI) = N+Y
        CALL  :E154     Get FRAC(MACC) = Y
        LXI   H,:00D5   Addr MACC
        MOV   A,M       Get exp.byte
        ANI   :7F       Exp only
        JZ    :E7FA     Jump if exp is 0
        CPI   :7E
        JC    :E818     Jump if exp < 7E
L1E133  CMP   M         Comp masked/non-masked exp
        LXI   H,:C462   Addr FPT (1)
        CNZ   :EA72     Add 1 to Y if X negative
        LXI   H,:E837   Addr FPT (0.25)
        PUSH  H         Save pntr
        CALL  :EA6D     MACC = MACC - 0.25
        CALL  :E9EE     Take abs. value
        LXI   H,:E83B   Addr FPT (0.5)
        CALL  :EA6D     MACC = MACC - 0.5
        CALL  :E9EE     Take abs. value
        POP   H         Get addr FPT (0.25)
        CALL  :EA6D     MACC = MACC - 0.25
L1E134  LXI   H,:00E3
        PUSH  H
        CALL  :E9D6     Copy MACC into 00E3-E6
        XTHL            HL=00E3; stack: 00E7
        CALL  :EA59     MACC = 2 * MACC
        POP   H         HL=00E7
        CALL  :E9DB     Copy 2*MACC into 00E7-EA
        CALL  :EA16     Clear MACC + reg ABCD
        LXI   H,:E83F   Addr Taylor sum constants
        CALL  :E5AA     Calc Taylor sum
        JMP   :C14D     Popall, ret
 REM
* CONSTANTS FOR 'XSIN' AND 'XCOS':
 REM
FPHPI   DATA  :01       FPT (PI/2)
        DATA  :C9
        DATA  :0F
        DATA  :DB
*
L1E304  DATA  :7F       FPT (0.25)
        DATA  :80
        DATA  :00
        DATA  :00
*
L1E305  DATA  :00       FPT (0.5)
        DATA  :80
        DATA  :00
        DATA  :00
*
L1E306  DATA  :03       a1: about PI*2
        DATA  :C9       6.2831853
        DATA  :0F
        DATA  :DB
*
        DATA  :86       a2: about -(PI*2)^3/3!
        DATA  :A5       -41.341681
        DATA  :5D
        DATA  :E2
*
        DATA  :07       a3: about (PI*2)^5/5!
        DATA  :A3       81.602481
        DATA  :34
        DATA  :78
*
        DATA  :87       a4: about -(PI*2)^7/7!
        DATA  :99       -76.581285
        DATA  :29
        DATA  :9E
*
        DATA  :06       a5: about (PI*2)^9/9!
        DATA  :9F       39.760722
        DATA  :0A
        DATA  :FB
*
        DATA  :00       End of table
        DATA  :00
*
*********
* POWER *
*********
*
* MACC = MACC ^ MEM.
*
* Entry: HL points to power in memory.
* Exit:  All registers preserved.
*
* Conditions for a^X:
*       a > 0.
*       ABS (x*ln(a)) in valid range.
*
* Method: a^X = e^(X*ln(a)).
*
XPWR    PUSH  PSW
        PUSH  B
        PUSH  D
        PUSH  H
        PUSH  H         Save addr X
        CALL  :E9F8     Get a in reg ABCD
        POP   H         Restore addr X
        JZ    :E86D     Abort if a = 0
        JM    :E9D0     Argument error if nr < 0
        CALL  :E745     MACC = ln(a)
        CALL  :EA59     MACC = X*ln(a)
        CALL  :E667     MACC = e^(X*ln(a))
XPW10   JMP   :C14D     Popall, ret
*
********
* LOGT *
********
*
* MACC = LOG (MACC).
*
* Method: log(X) = ln(x) / ln(10).
*
* Exit: All registers preserved.
*
XLOG    PUSH  PSW
        PUSH  B
        PUSH  D
        PUSH  H
        CALL  :E745     MACC = ln(ABS(X))
        LXI   H,:E890   Addr 1/ln(10)
        CALL  :EA59     MACC = ln(x)/ln(10)
        JMP   :C14D     Popall, ret
*
********
* ALOG *
********
*
* MACC = ALOG (MACC).
*
* Method: 10^X = e^(X*ln(10)).
*
* Exit: All registers preserved.
*
XALOG   PUSH  PSW
        PUSH  B
        PUSH  D
        PUSH  H
        LXI   H,:E890   Addr 1/ln(10)
        CALL  :EA20     MACC = X*ln(10)
        CALL  :E667     MACC = e^(X*ln(10))
        JMP   :C14D     Popall, ret
 REM
* CONSTANT FOR 'XLOG' AND 'XALOG':
 REM
FLGTI   DATA  :7F       1/ln(10)
        DATA  :DE
        DATA  :5B
        DATA  :D9
*
*******
* TAN *
*******
*
* MACC = TAN (MACC)  (Angle in radians).
*
* Method: tan(X) = sin(X)/cos(X).
*         In-accurate for X close to 0 or close
*         to n*PI/2.
*
* Exit: All registers preserved.
*
XTAN    PUSH  H
        CALL  :C21E     Save X on stack
        CALL  :E7D9     MACC = cos(X)
        LXI   H,:00EF
        CALL  :E11C     Store cos(X) in 00EF-F2
        CALL  :C234     Get X from stack
        CALL  :E7D2     MACC = sin(X)
        CALL  :E108     MACC = sin(X)/cos(X)
        POP   H
        RET
*
********
* ATAN *
********
*
* MACC = ATAN (MACC)  (Angle expressed in radians).
*
* Method: Polynomial approximation.
*
* ATAN(Z) for -0.25 <= Z <= 0.25 approximated by:
*       F(X) = X*(1 - Q1*X^2 + Q2*X^4 - Q3*X^6).
*
* To cope with range:
*       ATAN(-Z) = - ATAN(Z).
*       ATAN(Z) = a(k) + ATAN((Z-b(k))/(Z*b(k)+1)),
*                 with k = 1, 2 or 3,
*                 a(k) = k*PI/7,
*                 b(k) = TAN(a(k))
*
* Values for k:
*       k=0 if ABS(Z) < 0.25
*       k=1 if 0.25 < ABS(Z) < 0.75
*       k=2 if 0.75 < ABS(Z) < 2
*       k=3 if ABS(Z) > 2.
*
* Then X = (Z-b(k))/(Z*b(k)+1), and
*      ATAN(Z) =  a(k) + F(X), if Z >= 0
*      ATAN(Z) = -a(k) - F(X), if Z < 0.
*
XATAN   PUSH  PSW
        PUSH  B
        PUSH  D
        PUSH  H
        CALL  :EBF1     Check if Z=0
        JZ    :E943     Then abort
        PUSH  PSW       Save exp byte
        CALL  :E9EE     reg ABCD = ABS(Z)
        LXI   H,:00EF
        CALL  :E9DB     Copy ABS(Z) into 00EF-F2
 REM
* Calculate k:
 REM
        CPI   :40
        JC    :E8D3     Jump if exp < #40
        CPI   :7F
        MVI   A,:01
        JZ    :E8E6     k=1 if exp=#7F
        LXI   H,:C45E   Addr FPT(0)
        PUSH  H
        JMP   :E915     Cont with k=1, a(k)=0
L1E141  CPI   :01
        MVI   A,:02
        JZ    :E8E6     k=2 if exp=1
        JNC   :E8E3     k=3 if exp >1
        MOV   A,B       Get hibyte mantissa
        RLC
        RLC
        MVI   A,:01     k=1 if (B)= 10...
 REM k=2 if (B)= 11...
        CMC
L1E142  CMC
        ACI   :00
*
L1E143  ADD   A         Final k in A
        ADD   A
        ADD   A         *8
        LXI   H,:E93E   Startaddr for a,b table
        MOV   E,A       )
        MVI   D,:00     ) offset in DE
        DAD   D
        PUSH  H         Addr a(k)
        LXI   D,:0004
        DAD   D
        PUSH  H         Addr b(k)
        CALL  :EA59     MACC = Z*b(k)
        LXI   H,:C462   Addr FPT(1)
        CALL  :EA72     MACC = Z*b(k)+1
        LXI   H,:00DF
        CALL  :E9DB     (Z*b(k)+1) into 00DF-E2
        LXI   H,:00EF
        CALL  :E9FB     ABS(Z) in MACC
        POP   H         Addr b(k)
        CALL  :EA6D     MACC = Z-b(k)
        LXI   H,:00DF
        CALL  :EA20     MACC = X =
 REM = (Z-b(k))/(Z*b(k)+1)
L1E144  LXI   H,:00EF
        PUSH  H
        PUSH  H
        CALL  :E9D6     Copy X into 00EF-F2
        POP   H
        CALL  :EA59     MACC = X^2
        LXI   H,:00E3
        CALL  :E9DB     Copy X^2 into 00E3-E6
        CALL  :E9DB     Copy X^2 into 00E7-EA
        LXI   H,:C462   Addr FPT(1)
        CALL  :E9FB     Copy FPT(1) into MACC
        LXI   H,:E95E   Start table Taylor constants
        CALL  :E5AA     Calc Taylor sum
        POP   H
        CALL  :EA59     Taylor sum * X (=F(X))
        POP   H
        CALL  :EA72     Add a(k) (= ATAN(Z))
        POP   PSW       Get orig. exp byte
        ORA   A         Was Z negative ?
        CM    :E9E4     Then MACC = - ATAN(Z)
L1E145  JMP   :C14D     Popall, ret
 REM
* CONSTANTS FOR 'XATN':
 REM
FATC1   DATA  :7F       a(1): PI/7
        DATA  :E5       0.4487989506
        DATA  :C8
        DATA  :FA
*
        DATA  :7F       b(1): TAN(a(1))
        DATA  :F6       0.4815746188
        DATA  :90
        DATA  :F3
*
        DATA  :00       a(2): 2*PI/7
        DATA  :E5       0.8975979011
        DATA  :C8
        DATA  :FA
*
        DATA  :01       b(2): TAN(a(1))
        DATA  :A0       1.253960337
        DATA  :81
        DATA  :C6
*
        DATA  :01       a(3): 3*PI/7
        DATA  :AC       1.346396852
        DATA  :56
        DATA  :BB
*
        DATA  :03       b(3): TAN(a(3))
        DATA  :8C       4.381286272
        DATA  :33
        DATA  :7F
*
FATPL   DATA  :FF       Q1: about -1/3
        DATA  :AA       -0.333329573
        DATA  :AA
        DATA  :2D
*
        DATA  :7E       Q2: about 1/5
        DATA  :CC       0.199641035
        DATA  :6E
        DATA  :B3
*
        DATA  :FE       Q3: about -1/7
        DATA  :86       -0.131779888
        DATA  :F1
        DATA  :4F
*
        DATA  :00       End of table
        DATA  :00
*
********
* ASIN *
********
*
* MACC = ASIN (MACC).  Result in radians.
*
* Range: -PI/2 < X < PI/2.
*
* Method: ASIN(X) = ATAN(X/SQR(1-x^2)).
*
* Exit: All registers preserved.
*
XASIN   PUSH  PSW
        PUSH  B
        PUSH  D
        PUSH  H
        CALL  :E9F8     Get X in reg ABCD
        MOV   E,A       Exp byte in E
        ANI   :7F       Mask sign
        CPI   :01
        JC    :E999     Jump if in range
        JNZ   :E994     If >2 or <1
        MOV   A,B       )
        ANI   :7F       ) Check if mantissa
        ORA   C         ) = 80 00 00 (= +/- 1)
        ORA   D         )
        JNZ   :E9D0     Error if not
        MOV   A,E       Get exp
        ORA   A         Set flags on it
        LXI   H,:E833   Addr PI/2
        CALL  :E112     Copy PI/2 into MACC
        CM    :E9E4     If nr <0: MACC = -PI/2
FASRET  JMP   :C14D     Popall, ret
*
FAS10   CPI   :40
        JC    :E9D0     Error if exp <#40
FAS20   CALL  :C21E     Save X on stack
        LXI   H,:0000
        DAD   SP        HL=SP
        CALL  :EA59     MACC = X^2
        CALL  :E9E4     MACC = -X^2
        LXI   H,:C462   Addr FPT(1)
        CALL  :EA72     MACC = 1-X^2
        CALL  :E5F8     MACC = SQR(1-X^2)
        LXI   H,:00EF
        CALL  :E11C     SQR(1-X^2) in 00EF-F2
        CALL  :C234     Get X from stack in MACC
        CALL  :E108     MACC = X/(SQR(1-X^2))
        CALL  :E8AC     MACC = ATAN (MACC)
        JMP   :E991     Ready
*
*
********
* ACOS *
********
*
* MACC = ACOS (MACC). Result in radians.
*
* Range: 0 < X < PI.
*
* Method: ACOS(X) = PI/2 - ASIN(X).
*
* Exit: All registers preserved.
*
XACOS   CALL  :E96C     MACC = ASIN(X)
        CALL  :E14A     MACC = -ASIN(X)
        PUSH  H
        LXI   H,:E833   Addr PI/2
        CALL  :EDAA     MACC = PI/2-ASIN(X)
        POP   H
        RET
 REM
* Error exit:
 REM
FASER   CALL  :C05E     Run argument error
        JMP   :E991     Abort
*
*******************************************
* COPY MACC INTO OPERAND AND INTO A,B,C,D *
*******************************************
*
* Entry: HL points to operand.
* Exit:  HL points past operand.
*        AFBCD set as for ATEST.
*
* From ASTORE used to store reg A,B,C,D into
* an operand, pointed at by HL.
*
ASAVE   PUSH  H
        CALL  :E9F8     Copy MEM into MACC and ABCD
        POP   H
ASTORE  MOV   M,A       )
        INX   H         )
        MOV   M,B       ) Copy reg A,B,C,D into MEM
        INX   H         )
        MOV   M,C       )
        INX   H         )
        MOV   M,D       )
        INX   H         
        RET
*
*******************************
* SUBROUTINE CHANGE SIGN MACC *
*******************************
*
ACHGS   CALL  :EBF1     Check if MACC empty
        RZ              Then ready
        LXI   B,:FF80   Set mask
        JMP   :E9F1     Change sign bit
*
*****************************
* SUBROUTINE FPT ABS (MACC) *
*****************************
*
* From ATEST also used to copy MACC into ABCD.
* From L1E158 used to copy operand (pointed at
* by HL) into ABCD and into MACC.
*
L1E155  LXI   B,:7F00   Set mask
L1E156  LXI   H,:00D5   Addr MACC
        MOV   A,B       Mask in A
        ANA   M         AND exp byte with mask
        XRA   C         Set sign bit = 0
        MOV   M,A       Update exp byte MACC
*
ATEST   LXI   H,:00D5   Addr MACC
L1E158  CALL  :EBF4     Check if MEM = 0, get
 REM exp byte in A
        JZ    :EA16     Then clear MACC + ABCD
        MOV   E,A       exp byte in E
        INX   H         )
        MOV   B,M       )
        INX   H         ) Mantissa from MEM
        MOV   C,M       ) into BCD
        INX   H         )
        MOV   D,M       )
        LXI   H,:00D5   Addr MACC
        JMP   :EB17     Copy ABCD into MACC;
 REM exp from E in A, flags
 REM set on exp ORI 01
*
*
*
        END